Uma empresa de ônibus da cidade vem sofrendo uma cerrada concorrência com sua rival, pois nesta cidade não há exclusividade de rotas. Para melhorar seu atendimento e conquistar mais clientes, os gestores decidiram contratar uma empresa para uma grande pesquisa de opinião com seus clientes, descobrindo o perfil, pontos positivos e negativos da empresa, e assim identificar futuras melhorias. Um questionário foi elaborado, foram selecionados por sorteio 5000 clientes que usaram os ônibus da empresa nos últimos seis meses e os dados foram compilados na planilha “pesquisa_onibus”.
Sem dinheiro extra para contratar um analista de dados, a empresa resolveu contratar você como “consultor júnior freelance” para apresentar os resultados aos gestores. Verifique erros de digitação, inconsistências nos dados, pontos faltantes, discrepantes e redija um relatório incluindo tabelas, gráficos e resultados obtidos para apresentar ao final da ‘reunião’ que você foi chamado.
Antes de iniciar a análise, prossegue-se com a importação dos dados no R:
# Carrega a base de dados:
library(readxl)
dados <- read_xlsx("4. pesquisa_onibus.xlsx")
library(tidyverse) # Suite de pacotes para manipulação, análise e visualização de dados
library(kableExtra) # Trabalha com tabelas HTML
# Utiliza o map para verificar quantos registros NA's existem em cada variável. Depois gera tabela para apresentar os valores:
dados %>%
map_df(function(x) sum(is.na(x))) %>%
gather(Coluna, Ausentes) %>%
mutate(Percentual = paste0(formatC(Ausentes/nrow(dados)*100, format = "f", digits = 2), "%")) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Coluna | Ausentes | Percentual |
|---|---|---|
| Sexo | 7 | 0.14% |
| Frequencia | 9 | 0.18% |
| Conforto | 7 | 0.14% |
| Rota | 4 | 0.08% |
| Tipo | 6 | 0.12% |
| Pontualidade | 9 | 0.18% |
| Renda | 4 | 0.08% |
| Duracao | 7 | 0.14% |
| Idade | 6 | 0.12% |
| Volumes | 9 | 0.18% |
Observa-se que em todas as variáveis disponíveis no banco de dados, existem valores ausentes, porém em nenhuma das variáveis apresentadas, os valores ausentes chegam a representar 1% da massa de dados, logo pode-se afirmar que o percentual de dados ausentes é aceitável, portanto iremos retirar tais registros da análise.
dados %>%
group_by(Sexo) %>%
summarise(Quantidade=n()) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Sexo | Quantidade |
|---|---|
| Criança | 1 |
| Fe | 4 |
| Fem | 5 |
| Femi | 5 |
| Femin | 3 |
| Feminino | 2264 |
| Ma | 9 |
| Mas | 4 |
| Masc | 9 |
| Mascu | 4 |
| Masculino | 2685 |
| NA | 7 |
Observa-se alguns erros na grafia do Sexo. Para isso, utilizaremos uma função que irá corrigir cada registro errado. Para o registro com Sexo = Criança, iremos excluí-lo da análise.
dados <- dados %>%
mutate(Sexo = recode(Sexo, "Fe" = "Feminino",
"Fem" = "Feminino",
"Femi" = "Feminino",
"Femin" = "Feminino",
"Ma" = "Masculino",
"Mas" = "Masculino",
"Masc" = "Masculino",
"Mascu" = "Masculino"))
dados %>%
group_by(Sexo) %>%
summarise(Quantidade=n()) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Sexo | Quantidade |
|---|---|
| Criança | 1 |
| Feminino | 2281 |
| Masculino | 2711 |
| NA | 7 |
Observa-se, que todas as inconsistências de grafia foram corrigidas, apenas os registros nulo e “criança” serão excluídos.
dados %>%
group_by(Frequencia) %>%
summarise(Quantidade=n()) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Frequencia | Quantidade |
|---|---|
| Diário | 1 |
| Ev | 1 |
| Even | 3 |
| Eventual | 495 |
| Me | 5 |
| Men | 3 |
| Mens | 1 |
| Mensa | 4 |
| Mensal | 1747 |
| Se | 5 |
| Sem | 3 |
| Sema | 7 |
| Seman | 5 |
| Semanal | 2711 |
| NA | 9 |
Observa-se alguns erros na grafia da variável Para isso, utilizaremos uma função que irá corrigir cada registro errado.
dados <- dados %>%
mutate(Frequencia = recode(Frequencia, "Ev" = "Eventual",
"Even" = "Eventual",
"Me" = "Mensal",
"Men" = "Mensal",
"Mens" = "Mensal",
"Mensa" = "Mensal",
"Se" = "Semanal",
"Sem" = "Semanal",
"Sema" = "Semanal",
"Seman" = "Semanal"))
dados %>%
group_by(Frequencia) %>%
summarise(Quantidade=n()) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Frequencia | Quantidade |
|---|---|
| Diário | 1 |
| Eventual | 499 |
| Mensal | 1760 |
| Semanal | 2731 |
| NA | 9 |
Observa-se, que todas as inconsistências de grafia foram corrigidas, apenas os registros nulo e “Diário” serão excluídos.
dados %>%
group_by(Conforto) %>%
summarise(Quantidade=n()) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Conforto | Quantidade |
|---|---|
| Ac | 3 |
| Ace | 2 |
| Acei | 4 |
| Aceit | 2 |
| Aceitável | 974 |
| Bom | 1 |
| Excelente | 234 |
| Ir | 4 |
| Irr | 5 |
| Irre | 5 |
| Irreg | 2 |
| Irregular | 2271 |
| Pé | 3 |
| Pés | 4 |
| Péss | 7 |
| Péssi | 3 |
| Péssimo | 1469 |
| NA | 7 |
Observa-se alguns erros na grafia da variável Para isso, utilizaremos uma função que irá corrigir cada registro errado.
dados <- dados %>%
mutate(Conforto = recode(Conforto, "Ac" = "Aceitável",
"Ace" = "Aceitável",
"Acei" = "Aceitável",
"Aceit" = "Aceitável",
"Ir" = "Irregular",
"Irr" = "Irregular",
"Irre" = "Irregular",
"Irreg" = "Irregular",
"Pé" = "Péssimo",
"Pés" = "Péssimo",
"Péss" = "Péssimo",
"Péssi" = "Péssimo"))
dados %>%
group_by(Conforto) %>%
summarise(Quantidade=n()) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Conforto | Quantidade |
|---|---|
| Aceitável | 985 |
| Bom | 1 |
| Excelente | 234 |
| Irregular | 2287 |
| Péssimo | 1486 |
| NA | 7 |
Observa-se, que todas as inconsistências de grafia foram corrigidas, apenas os registros nulo e “Bom” serão excluídos.
dados %>%
group_by(Rota) %>%
summarise(Quantidade=n()) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Rota | Quantidade |
|---|---|
| Car | 1 |
| Cara | 6 |
| Caram | 1 |
| Carambola | 1242 |
| Go | 2 |
| Goi | 2 |
| Goia | 5 |
| Goian | 2 |
| Goianésia | 1256 |
| Ji | 3 |
| Jil | 4 |
| Jilo | 2 |
| Jiloz | 2 |
| Jilozinho | 975 |
| Madureira | 1 |
| Pa | 5 |
| Par | 4 |
| Para | 1 |
| Paranaval | 1482 |
| NA | 4 |
Observa-se alguns erros na grafia da variável Para isso, utilizaremos uma função que irá corrigir cada registro errado.
dados <- dados %>%
mutate(Rota = recode(Rota, "Car"="Carambola",
"Cara"="Carambola",
"Caram"="Carambola",
"Go"="Goianésia",
"Goi"="Goianésia",
"Goia"="Goianésia",
"Goian"="Goianésia",
"Ji"="Jilozinho",
"Jil"="Jilozinho",
"Jilo"="Jilozinho",
"Jiloz"="Jilozinho",
"Pa"="Paranaval",
"Par"="Paranaval",
"Para"="Paranaval"))
dados %>%
group_by(Rota) %>%
summarise(Quantidade=n()) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Rota | Quantidade |
|---|---|
| Carambola | 1250 |
| Goianésia | 1267 |
| Jilozinho | 986 |
| Madureira | 1 |
| Paranaval | 1492 |
| NA | 4 |
Observa-se, que todas as inconsistências de grafia foram corrigidas, apenas os registros nulo e “Madureira” serão excluídos.
dados %>%
group_by(Tipo) %>%
summarise(Quantidade=n()) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Tipo | Quantidade |
|---|---|
| Di | 5 |
| Dir | 4 |
| Dire | 1 |
| Diret | 1 |
| Direto | 1754 |
| Excursão | 1 |
| Le | 3 |
| Lei | 2 |
| Leito | 989 |
| Pa | 6 |
| Par | 8 |
| Para | 3 |
| Parad | 8 |
| Parador | 1721 |
| Sem | 2 |
| Semi- | 2 |
| Semi-direto | 484 |
| NA | 6 |
Observa-se alguns erros na grafia da variável Para isso, utilizaremos uma função que irá corrigir cada registro errado.
dados <- dados %>%
mutate(Tipo = recode(Tipo, "Di"="Direto",
"Dir"="Direto",
"Dire"="Direto",
"Diret"="Direto",
"Le"="Leito",
"Lei"="Leito",
"Pa"="Parador",
"Par"="Parador",
"Para"="Parador",
"Parad" = "Parador",
"Sem"="Semi-direto",
"Semi-"="Semi-direto"))
dados %>%
group_by(Tipo) %>%
summarise(Quantidade=n()) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Tipo | Quantidade |
|---|---|
| Direto | 1765 |
| Excursão | 1 |
| Leito | 994 |
| Parador | 1746 |
| Semi-direto | 488 |
| NA | 6 |
Observa-se, que todas as inconsistências de grafia foram corrigidas, apenas os registros nulo e “Excursão” serão excluídos.
dados %>%
group_by(Pontualidade) %>%
summarise(Quantidade=n()) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Pontualidade | Quantidade |
|---|---|
| Ac | 1 |
| Ace | 4 |
| Aceitável | 787 |
| Ex | 2 |
| Exce | 1 |
| Excelente | 219 |
| Ir | 1 |
| Irr | 8 |
| Irre | 10 |
| Irreg | 4 |
| Irregular | 2126 |
| Pé | 4 |
| Péss | 2 |
| Péssi | 5 |
| Péssima | 1816 |
| Ruim | 1 |
| NA | 9 |
Observa-se alguns erros na grafia da variável Para isso, utilizaremos uma função que irá corrigir cada registro errado.
dados <- dados %>%
mutate(Pontualidade = recode(Pontualidade, "Ac"="Aceitável",
"Ace"="Aceitável",
"Ex"="Excelente",
"Exce"="Excelente",
"Ir"="Irregular",
"Irr"="Irregular",
"Irre"="Irregular",
"Irreg"="Irregular",
"Pé"="Péssima",
"Péss"="Péssima",
"Péssi"="Péssima"))
dados %>%
group_by(Pontualidade) %>%
summarise(Quantidade=n()) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Pontualidade | Quantidade |
|---|---|
| Aceitável | 792 |
| Excelente | 222 |
| Irregular | 2149 |
| Péssima | 1827 |
| Ruim | 1 |
| NA | 9 |
Observa-se, que todas as inconsistências de grafia foram corrigidas, apenas os registros nulo e “Ruim” serão excluídos.
dados %>%
select(Renda, Duracao, Idade, Volumes) %>%
summary()
## Renda Duracao Idade Volumes
## Min. :-5.77 Min. : 1.10 Min. : 3.2 Min. : 0.000
## 1st Qu.: 4.75 1st Qu.: 12.00 1st Qu.:28.0 1st Qu.: 1.000
## Median : 5.71 Median : 22.00 Median :35.0 Median : 1.000
## Mean : 6.57 Mean : 24.67 Mean :35.2 Mean : 1.795
## 3rd Qu.: 7.12 3rd Qu.: 33.00 3rd Qu.:42.0 3rd Qu.: 3.000
## Max. :53.64 Max. :174.00 Max. :85.0 Max. :42.000
## NA's :4 NA's :7 NA's :6 NA's :9
Observa-se que a variável renda possui um valor negativo. Na variável duração um valor com casas decimais, em Idade valor inferior a 18 e Volume com valor discrepante igual a 42.
Verificamos vários problemas nos registros de cada variável, a sugestão para que as próximas informações venham sem estes erros, é implementar formulários de pesquisa padrão, limitando o usuário a selecionar as opções disponíveis em tela. Isso minimizaria consideravelmente os erros encontrados.
Foram apresentados no item acima.
Os erros de grafia já foram corrigidos nos passos acima. Resta fazer agora apenas os filtros dos valores discrepantes que foram encontrados. No código abaixo fazemos estes filtros e removemos os registros nulos.
df_aj <- dados %>%
filter(Renda>0,
Duracao>1.1,
Idade>3.2,
Volumes<42,
Volumes != 7.5,
Sexo != "Criança",
Frequencia != "Diário",
Conforto != "Bom",
Rota != "Madureira",
Tipo != "Excursão",
Pontualidade != "Ruim") %>%
na.omit
x <- data.frame(registros = c(nrow(df_aj), nrow(dados)), base = c("Final", "Inicial"))
library(plotly) # Pacote para confecção dos gráficos:
p <- plot_ly(x, x=~base, y=~registros, type = "bar") %>%
layout(title = 'Quantidade de registros por tipo de base')
p
Após a limpeza realizada na base, ficamos com 4.921 registros.
Para isso, vamos gerar uma gráfico de setores, com a distribuição de mulheres e homens:
# Prepara a base para o gráfico
graf <- df_aj %>%
group_by(Sexo) %>%
summarise(Freq = n())
# Gera o gráfico
p <- plot_ly(graf, labels = ~Sexo, values = ~Freq, type = 'pie') %>%
layout(title = 'Distribuição da variável Sexo')
p
Podemos verificar que, dentre o volume de dados analisados, 54,4% (2.676) dos indivíduos são do Sexo Masculino, enquanto os 45,6% (2.245) restantes são Mulheres. Portanto, apesar de não haver diferença tão expressiva, a quantidade de clientes homens da empresa é superior à quantidade de mulheres.
Vamos começar fazendo um gráfico de colunas com a distribuição da variável “Frequência”:
# Prepara a base para o gráfico
graf <- df_aj %>%
group_by(Frequencia) %>%
summarise(Freq = n()) %>%
mutate(R_Freq = Freq/sum(Freq)) %>%
ungroup() %>%
mutate(Perc = paste0(formatC(R_Freq*100, digits = 2, format = "f"), "%"))
# Gera o gráfico
p <- plot_ly(graf, x = ~Frequencia, y = ~Freq, type = 'bar', text = ~Perc) %>%
layout(title = 'Distribuição da variável Frequência')
p
Verificamos que a grande maioria dos clientes (54,74%) possuem o hábito de viajarem semanalmente, 35,26% viajam mansalmente e apenas 10% viajam esporadicamente.
Mas apenas uma análise crua da variável, não traz informações suficientes para tomada de decisões. E se verificarmos a frequência de viagens por sexo?
# Prepara base para o gráfico
graf <- df_aj %>%
group_by(Frequencia, Sexo) %>%
summarise(Freq = n()) %>%
spread(key = Sexo, value = Freq) %>%
ungroup() %>%
mutate(r_fem = paste0(formatC(Feminino/sum(Feminino)*100, digits = 2, format = "f"), "%"),
r_masc = paste0(formatC(Masculino/sum(Masculino)*100, digits = 2, format = "f"), "%"))
# Gera o gráfico
p <- plot_ly(graf, x = ~Frequencia, y = ~Masculino, type = 'bar', name = "Masculino", text = ~r_masc) %>%
add_trace(y = ~Feminino, name = "Feminino", text = ~r_fem) %>%
layout(title = 'Distribuição da variável Frequência por Sexo', yaxis = list(title = ""))
p
Quando verificamos o hábito de viagem por Sexo, podemos perceber que as mulheres possuem o hábito de realizar viagens com maior frequência, sendo que 69,09% das mulheres viajam semanalmente, enquanto 42,71% dos homens possuem o mesmo hábito.
O cenário inverte quando se analisa as viagem mensais, enquanto 42,86% dos homens viajam mensalmente apenas 26,19% das mulheres possuem este hábito.
Cenário semelhante também para as pessoas que viajam esporadicamente. Dentre os homens, 14,42% possuem este perfil e dentre as mulheres 4,72%.
Primeiramente, vamos criar um gráfico com a distribuição da variável “Conforto”
# Cria vetores para ordenação dos dados
ordem_conforto <- c("Péssimo", "Irregular", "Aceitável", "Excelente")
ordem_frequencia <- c("Semanal", "Mensal", "Eventual")
# Prepara a base para o gráfico
graf <- df_aj %>%
group_by(Conforto) %>%
summarise(Freq = n()) %>%
mutate(R_Freq = Freq/sum(Freq)) %>%
ungroup() %>%
mutate(Perc = paste0(formatC(R_Freq*100, digits = 2, format = "f"), "%"),
Conforto = factor(Conforto, levels = ordem_conforto)) %>%
arrange(Conforto) # ordena
# Cria paleta de cores:
pal <- c("#d68080", "#d6c080", "#c0d680", "#80d680")
# Gera o gráfico
p <- plot_ly(graf, x = ~Conforto, y = ~Freq, type = 'bar', text = ~Perc, color = ~Conforto, colors = pal) %>%
layout(title = 'Distribuição da variável Conforto')
p
Podemos verificar que a grande maioria dos usuários (45,93%), classificaram o conforto dos ônibus como Irregular. 29,69% classificaram como Péssimo, 19,69% como Aceitável e apenas 4,69% como Excelente.
Essa informação contraria a suspeita da empresa de que, em geral, os usuários achariam que os ônibus são confortáveis.
Se cruzarmos a informação de Conforto dos usuários com Frequência de viagens e Sexo, podemos ter outros insights (vide gráfico a seguir), como por exemplo:
# Ajusta a base de dados:
graf <- df_aj %>%
group_by(Conforto, Frequencia, Sexo) %>%
summarise(Freq = n()) %>%
ungroup() %>%
mutate(Conforto = factor(Conforto, levels = ordem_conforto),
Frequencia = factor(Frequencia, levels = ordem_frequencia)) %>%
arrange(Conforto, Frequencia)
# Gera o gráfico
p1 <- graf %>%
filter(Sexo == "Feminino") %>%
plot_ly(x = ~Frequencia, y = ~Freq, color = ~Conforto, type = 'bar', legendgroup = ~Conforto, showlegend = F, colors = pal) %>%
layout(xaxis = list(title = "Feminino"))
p2 <- graf %>%
filter(Sexo == "Masculino") %>%
plot_ly(x = ~Frequencia, y = ~Freq, color = ~Conforto, type = 'bar', legendgroup = ~Conforto, colors = pal) %>%
layout(xaxis = list(title = "Masculino"))
p <- subplot(p1,p2,shareY = T, titleX = T, shareX = T, margin = 0.05)
p
Vamos montar uma simples tabela de frequência para responder essa pergunta. Podemos verificar que o volume de viagens para as quatro rotas apresentadas é bem parecido. Destaca-se Paranaval, que possui quase 30% das viagens e Jilozinho, que possui 19,69% das viagens.
# Ajusta a base de dados:
df_aj %>%
group_by(Rota) %>%
summarise(Quantidade = n()) %>%
ungroup() %>%
mutate(Percentual = paste0(formatC(Quantidade/sum(Quantidade)*100, digits = 2, format = "f"), "%")) %>%
ungroup() %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Rota | Quantidade | Percentual |
|---|---|---|
| Carambola | 1227 | 24.93% |
| Goianésia | 1255 | 25.50% |
| Jilozinho | 969 | 19.69% |
| Paranaval | 1470 | 29.87% |
Vamos novamente criar uma tabela com a distribuição da variável Tipo. Podemos perceber que os dois tipos de ônibus mencionados (direto e parador), possuem quantidade de viagens semelhante. Ambas representam cerca de 70% das viagens, portanto podemos apresentar outras visões que auxiliam a empresa na hora de tomar a decisão.
# Ajusta a base de dados:
df_aj %>%
group_by(Tipo) %>%
summarise(Quantidade = n()) %>%
ungroup() %>%
mutate(Percentual = paste0(formatC(Quantidade/sum(Quantidade)*100, digits = 2, format = "f"), "%")) %>%
ungroup() %>%
arrange(desc(Quantidade)) %>%
kable(align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| Tipo | Quantidade | Percentual |
|---|---|---|
| Direto | 1745 | 35.46% |
| Parador | 1717 | 34.89% |
| Leito | 982 | 19.96% |
| Semi-direto | 477 | 9.69% |
graf <- df_aj %>%
group_by(Sexo, Frequencia, Conforto, Rota) %>%
summarise(value = n()) %>%
ungroup()
graf <- rbind(graf %>%
select(Sexo,Frequencia, value) %>%
rename(source = Sexo, target = Frequencia),
graf %>%
select(Frequencia, Conforto, value) %>%
rename(source = Frequencia, target = Conforto),
graf %>%
select(Conforto, Rota, value) %>%
rename(source = Conforto, target = Rota)
)
graf <- graf %>%
group_by(source, target) %>%
summarise(value = sum(value))
node_names <- factor(sort(unique(as.character(unname(unlist(graf[1:2]))))))
nodes <- data.frame(name = node_names)
links <- data.frame(source = match(graf$source, node_names) - 1,
target = match(graf$target, node_names) - 1,
value = graf$value)
links <- links[!is.na(links$source), ]
library(plotly)
p <- plot_ly(
type = "sankey",
orientation = "h",
node = list(
label = node_names,
color = rep("blue", length(node_names)),
pad = 15,
thickness = 20,
line = list(
color = "black",
width = 0.5
)
),
link = list(
source = links$source,
target = links$target,
value = links$value
)
) %>%
layout(
title = "Basic Sankey Diagram",
font = list(
size = 10
)
)
p